perm filename NOTWRT.F4[XX,LCS]2 blob
sn#182688 filedate 1975-10-19 generic text, type T, neo UTF8
00200 SUBROUTINE NOTWRT
00300 IMPLICIT INTEGER(A-Q,S-Z)
00400 COMMON/DL/IXRX,M,AA /FONT/JFONT
00500 COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
00600 DIMENSION RACNT(65),RDOT(7),XAC(7),RNOTE(22)
00650 1,RACCI(22),NACCI(3)
00700 REAL DIS,CENTR,POS,STFF
00800 COMMON /STF/RSTFAC(-3/4),RSTJ2
00900 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
01000 COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(-3/4),JJ2,POS
01300 C FOR NOTE DRAWING
01310 COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
01320 1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,J5X,RXX,JJJ,
01330 1 PUNCT,RDIS,RJ
01400 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
01500 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01600 1,(J11,JQ(9)),(J6,JQ(4)),(R5,RJQ(3)),(R11,RJQ(9))
01700 1,(R8,RJQ(6)),(R7,RJQ(5)),(RX,JRX),(RJZ,RJQ(20)),(R3,RJQ(1))
01800 DATA RACNT/4.0,1000.005,17.0,0.105, 8.0,1003.0, 7.014, 11.0
01900 1,13. ,1000. ,0.010,14.01,14. ,17. ,1001.018,7. ,13.018,27.,
02000 1 1004., 4.002, 6.004, 8.004,10.002,10., 8.102,6.102,4.
02100 1,32.0,1000.0,14.0,1007.007,7.107, 43.0,1012.01,11.006,9.003
02200 1, 7.001, 5.0, 9.002, 13.006, 15.01, 10.004, 13.009, 52.0,
02300 1 1002.008,3.003, 5.001, 8.0, 10.0, 13.001, 15.003, 16.008,
02305 1 65.,1106.104, 0.002, 6.104, 12.002, 18.104, 24.002, 24.003,
02307 1 18.103, 12.003, 6.103, 0.003, 106.103/
02310 1 ,RNOTE/ 1000., 5.007, 11.007, 16., 11.107, 5.107, 0.0,
02340 1 1000.0, 7.007, 14.0, 7.107, 0, 1000.107, 14.007,
02370 1 1014.107,0.007, 1000.003,4.107,6.007,9.107,11.007,14.103/
02400 DATA RDOT/1000.0, 0.103, 1.0, 1.103, 2.0, 2.103,0/
02500 1 , R5/5.0/, R66/66.0/, R72/72.0/,R18/18.0/,RSTM/14.54/
02600 1 ,XAC/9,14,18,28,33,44,53/
02700 C ALL DATA NUMS OVER 90 GIVE INVISIBLE VECTORS
02800 DATA RACCI/6.0,1115.003, 110.007, 106.001,
02816 1 115.109, 115.021, 15.0, 1104.104, 118.108,
02832 1 1108.113, 108.016, 1104.008, 118.004,
02848 1 1114.014, 114.115, 22.0,1106.117, 106.007, 114.004
02864 1, 1114.018, 114.107, 106.104/
02880 1 ,NACCI/1,7,16/
02890
02900 RST7=7.*RSTJ2
03510 RST3=3.*RSTJ2
03520 RSTX=RSTJ2
03560 C FOR MINIS AT 245
03600 RMINI=RSTJ2
03700 C OR SHOULD THIS ONLY BE IN NOTES, ETC? 15/9/72
03800
04100 RINV=1
04200 IF(JA.EQ.1)GO TO 11
04400 IF(JA.EQ.9)GO TO 242
04700
04750 C NEXT IS FOR RESTS
04760 IF(R8.NE.0)J5=-2
04780 C R8 PUTS NUMBER OVER WHOLE REST ONLY.
04800 IF(J5.GT.1)R4=R4-2
04900 CC RA=R4
05000 R7=R6*10.
05100 C FOR DOTS
05200 202 CALL REST
05300 IF(J5.GT.1)GO TO 200
05400 IF(R7.EQ.0)RETURN
05900 201 RA=14
05950 R6=0
06000 IF(J5)RA=19
06100 R3=R3+RA*RSTJ2
06200 R4=8.+R4
06300 JA=9
06400 J5=7
06500 C IF P6=1 THE REST IS DOTTED
06600 CALL CENTX
06650 GO TO 242
06700 200 J5=J5-1
06800 C FOR MULTIPLE TAILS ON 16TH REST, ETC.
06900 R4=R4+2.
07000 CALL RJBX(4.3)
07100 GO TO 202
07200
10200 29 RJX=R3
10300 RJY=CENTR+RSTJ2
10350 108 IF(WHOLE.NE.0)RJX=RJX+3.*RMINI
10375 C WHOLE=1 MEANS IT'S A WHOLE NOTE (WIDER THAN A HALF.)
10387 WHOLE=0
10400 107 CALL RDRAW(1,7.0,RDOT,RMINI,RJX,RJY,RMINI)
10410 C **** **** *** ↑↑↑↑↑↑↑↑↑↑ THESE WERE RSTJ2 11/74
10420 IF(JA.EQ.1)GO TO 290
10500 IF(R7.GE.20.)GO TO 290
10600 RB=POS+52.*RSTJ2
10700 IF(RJY.NE.RB)GO TO 6241
10800 C WHERE IS RB USED LATER?
10900 RJY=RJY-12*RSTJ2
11000 GO TO 107
11100 C ABOVE FOR DOTS
11200 290 R7=R7-10.
11300 IF(R7.LT.10.)GO TO 1342
11400 RJX=RJX+RSTJ2*10.
11500 GO TO 107
11600
14300 GO TO 1121
14400
14500 C NOTES****
14600 11 JY=0
14610 IF(R6.EQ.0)GO TO 1015
14620 JY=IABS(J6)
14700 R6=ABS(AMOD(R6,1.0))*10.
14800 C R6 WILL HAVE ACCENT CODE # (.7=DOT, ETC.)
14900 1015 L=IABS(J4)
15140 RJAC=R3
15160 C TO SAVE POS. OF NOTE FOR ACCENT
15510 RZTM=2.*RSTJ2
15520 STEM=J5/10
15700 IF(L.LT.100)GO TO 1013
15800 IF(L.LT.200)GO TO 1012
15900 RZTM=0
16000 IF(L.GE.300)GO TO 1014
16010 KL=8
16100 RG=12.0
16200 C FOR DIAMOND NOTES.
16300 GO TO 1017
16350 1014 IF(L.GE.400)GO TO 1016
16400 RJX=RMINI*7
16410 C FOR "X" NOTES.
16500 KL=13
16600 RG=16.
16700 RB=CENTR+RJX
17000 IF(STEM.EQ.2)RB=CENTR-RJX
17100 GO TO 1017
17150
17160 1016 RB=CENTR+R11*RST7
17165 C FOR NO NOTE HEAD. P11 CAN ADJUST SOURCE OF STEM.
17170 GO TO 1017
17180
17200 1012 RMINI=.6*RSTJ2
17300 C FOR RMINI NOTES
17400 1017 R4=AMOD(R4,100.)
17440 C FOR MINI TAILS AND ACCIS. ETC.
17500 1013 J4=R4
17600 RJZ=R4
17650 C RJZ FOR FLAT, #, NAT. RX4 FOR TR., HARM, ETC.
17700 RX4=R4
17900 IF(JY.LT.10)GO TO 2221
18000 IF(JY.GE.30)GO TO 2221
18100 C P6 FOR HOMING TO RIGHT(10,30) OR LEFT(20) OF STEM(10,30=UP, 20=DOWN)
18200 C P6<0 = WHITE NOTE
18300 RQ=RSTM
18400 IF(J6)RQ=RQ+1.66
18500 C GETS WIDTH OF NOTE DISPLACEMENT
18600 IF(JY.EQ.20)RQ=-RQ
18700 R3=R3+RQ*RMINI
18710 2221 IF(J4.LE.1)GO TO 322
18800 IF(J4.LT.13)GO TO 1121
18850
18860 322 IF(J9)GO TO 1121
18900 C ARE THERE LEDGER LINES? P9=-1 SUPPRESSES THEM.
19000 J11=(J4+1)/2-6
19100 IF(J11)J11=-((3-J4)/2)
19200
19203 C FOR LEDGER LINES
19212 RJW=R3-7.*RMINI
19215 RZ=R3+20.*RMINI
19218 IF(J11)GO TO 71
19221 JX=J11
19224 JRX=13
19227 C********* 18/9/72
19230 GO TO 711
19233 71 JX=-J11
19236 JRX=J11*2+3
19239 711 RX=POS-18*RSTJ2+RST7*JRX
19242 C********* 18/9/72
19245 IF(J6)RZ=RZ+2*RMINI
19248 C126 IF(PLT.EQ.-3)GO TO 1126
19251 C FOR 2-PASS PLOTTING
19254 C ******* ABOVE IS NOT USED, 15/9/72
19257 126 CALL LINX(RJW,RX,RZ,RX)
19260 IF(PLT.NE.-2)GO TO 1126
19263 RJY=RX-1./RHT
19266 CALL LINX(RJW,RJY,RZ,RJY)
19269 1126 IF(JX.EQ.1)GO TO 1122
19272 RX=RX+RSTJ2*14.
19275 JX=JX-1
19278 GO TO 126
19281 1122 J9=-1
19291
19300 C IF J6≠0 NOTE IS FILLED IN
19320 1121 IF(L.GE.400)GO TO 123
19360 C JUMP IF NO NOTE HEAD
19380 IF(J6)GO TO 1322
19400 IF(L.LT.200)GO TO 125
19405 1322 IF(L.GE.200)GO TO 1253
19407 C FOR DIAMOND AND X NOTES.
19410 KL=1
19420 RG=7.
19430 C FOR WHITE NOTES ON DPY.
19440 WHOLE=MOD(J7,10)
19450 IF(WHOLE.EQ.0)GO TO 2122
19455 STEM=0
19460 C FOR VARIOUS AUTOMATIC FEATURES IN 'SCORE' SECTION.
19470 J7=0
19490 R5=AMOD(R5,10.)
19495 J5=R5
19500 2122 IF(PLT.GE.0)GO TO 1253
19600 IF(L.GE.200)GO TO 1253
19805 2121 J5=15+WHOLE
19806 C IF WHOLE=1, THEN WHOLE NOTE SHAPE INSTEAD OF HALF. (P7=1)
19807 RG=RSTJ2
19808 C FIX THIS SOME DAY↓↓ SEE 1342+1!
19810 CCXX IF(RMINI.NE.RSTJ2)RSTJ2=.7*RSTJ2
19832 C THESE NOTES ARE IN CLEF1. 1/2=13 WHOLE=14
19835 JX4=J4
19836 RQ=R7
19837 C SAVE IT FOR DOTS
19840 CALL DRWNT(RMINI)
19841 R7=RQ
19842 J4=JX4
19843 C GET IT BACK
19845 RSTJ2=RG
19850 C DRAWS GOOD NOTES ON PLOTTER -- NOT ON DPY.
19860 CC DONE IN DRWNT R7=J7
19870 C TO RESET IT.
20200 GO TO 123
20300 1251 CALL NOIR(RMINI)
20310 C FOR QUARTER NOTES ON PLOTTER.
20400 GO TO 123
20500
20600 125 IF(PLT)GO TO 1251
20700 KL=17
20800 RG=22.
21300 C ABOVE IS NEW NOTES ROUTINE
21310 1253 CALL RDRAW(KL,RG,RNOTE,RMINI,R3,CENTR,RMINI)
21400
21500 123 R5=R5-J5
21600 C R5=STEPS TO LEFT FOR ACCID. (.1=1 STEP)
21700 IF(STEM.EQ.0)GO TO 1242
21800 IF(L.LT.300)RB=CENTR+RZTM
21850 C************↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑ +2
21900 C ≥300 IS FOR 'X' NOTES.
22000 128 J7=MOD(J7,10)
22100 RG=(J7-1)*14
22200 IF(RG)RG=0
22270 IF(R8.EQ.999)R8=0
22300 IF(R8.LT.999)GO TO 751
22375 R8=R8-1000.
22387 J10=1
22393 C 1000+ PUTS SLASH ON NOTE STEM
22500 751 RH=R8*RST7
22600 C STEM EXTENSIONS ARE BY NOTE #S
22700 IF(STEM.NE.2)GO TO 1280
22800 RJX=R3
22900 C FOR STEM DOWN (=2)
23000 RG=-RG-48.
23100 RH=-RH
23200 L=20
23750 RB=RB-RZTM*2
23755 C FOR TILT OF ORDINARY NOTES (NOT X OR DIAMOND)
23760 C************↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑ SEE 21800 12/74
23800 GO TO 129
23900 C NEXT IS FOR STEM UP.
24000 1280 RJX=RSTM
24420 IF(J6.EQ.0)GO TO 2322
24500 IF(J6.NE.30)RJX=16.2
24600 C FOR HALF NOTES
24700 2322 RJX=RJX*RMINI+R3
24800 RG=RG+48.
24900 L=10
25200 129 RZ=CENTR+RH+RG*RMINI
25300 IF(RMINI.NE.RSTJ2)RJW=RJW*.6
25400 CALL LINX(RJX,RB,RJX,RZ)
25500 C RB HERE IS CENTR (FOR 'X' NOTES OR NOT)
25600 227 J5=J5-L
25700 C J5 HAS ACCID. # NOW
25800 IF(J7.EQ.0)GO TO 1242
25810 C JUMP IF NO TAILS
25820 RJW=2.*RMINI/RSTJ2
25830 C FOR VERT. SPACING OF MULTIPLE TAILS
25910 IF(STEM.NE.2)GO TO 1127
25920 R4=R4-3.7-R8
25930 C R4 IS USED IN SUBR. TAIL - R8 IS STEM EXTENSION.
25940 RJW=-RJW
25950 RA=1.
25960 GO TO 127
25984 1127 R4=R4-2+R8
25991 C 2 ABOVE AND 3.7 BEFORE ARE BECAUSE ORIG. POS. OF TAIL DRWING IS OFF.
25996 RA=-1.
25998 R8=0
25999 C ↑↑↑↑↑↑ FOR SHIFT AT 246
26000 127 CALL TAIL(RJX,RA,RMINI)
26100 1028 J7=J7-1
26200 IF(J7.EQ.0)GO TO 327
26300 R4=R4+RJW
26400 C MOVES CENTR UP OR DOWN FOR NEXT TAIL
26500 GO TO 127
26562 327 IF(R4.GE.RX4)RX4=R4+1
26570 CC327 IF(R4.GE.RJZ)RJZ=R4+1
26575 C FOR TRILLS, ETC.
26600 IF(J10.EQ.0)GO TO 1242
26700 RJY=RZ-19*RSTJ2
26800 RZ=RZ-RSTJ2*4.
26900 IF(RA.LT.0)GO TO 1327
27000 C NEXT IS FOR STEM DOWN SLASH
27100 RJY=RZ+23*RSTJ2
27200 RZ=RZ+RST7
27300 1327 RJX=RJX-RST7
27400 CALL LINX(RJX,RJY,RJX+17.*RSTJ2,RZ)
27500 C FOR SLASH ON GRACE NOTE TAIL
27600 1242 IF(R7.LT.10.)GO TO 1342
27700 C FOR DOTTED NOTE-- P7>9
27800 RJX=RJAC+(22.+AMOD(R7,1.0)*59.6)*RMINI
27850 C***↑↑↑↑↑ WAS 24. 11/74
27900 RJY=CENTR+RSTJ2
28000 IF(JY.EQ.10)GO TO 4322
28050 IF(JY.NE.30)GO TO 3322
28075 4322 RJX=RJX+RSTM
28100 C MOVES DOT TO LEFT
28200 3322 IF(MOD(J4,2).EQ.0)GO TO 108
28300 RX=RST7
28400 IF(JY.GE.20)RX=-RX
28500 3342 RJY=RJY+RX
28600 GO TO 108
28700 C JY=30= STEM UP, INTERVAL OF SECOND.
28710 1342 IF(J5.NE.0)GO TO 5322
28755 IF(R6.EQ.0)RETURN
28800 5322 R3=R3-R5*59.6*RMINI
28900 C TO SPACE OUT ACCIDS.
29000 CCXX IF(RMINI.NE.RSTJ2)RSTJ2=.7*RSTJ2
29100 C ↑↑↑↑ ↑↑↑↑↑ WAS RMINI
29200 C********* 18/9/72
29300 242 IF(J5.GE.0)GO TO 2421
29400 RINV=-RINV
29500 J5=-J5
29600 C NOW THAT 0 IS NOT USED FOR DOTS THE ABOVE 3 LINES COULD BE CHNGD
29700 C********** LAST # WAS 281?
29800 C b,#,NAT, ACC ∧, ACC >, FERMATA, DOT, REP MEAS., DASH
29900 CXX 11/74 2421 RH=14
29910 2421 J5X=-1
29920 JAX=JA
29960 C USED AT 4241 FOR DOUBLE MARKS ON NOTES.
30000 IF(JA.EQ.9)GO TO 2423
30010 IF(J5.GT.3)GO TO 3121
30020 C DBL FLT(4) AND DBL SHRP(5) ALWAYS USE 'DRAW' ROUTINE.
30030 GO TO 211
30050 2423 RJZ=AMOD(R4,100.)
30075 C FOR 'DRWNT' WHEN PLOTTING.
30100 CALL NOZERO(R6)
30200 C R6=SIZE FACTOR (P6)
30300 RMINI=RMINI*R6
30400 R6=0
30500 STEM=0
30600 C FOR MISC. ITEMS
30700 210 IF(IABS(J4).LT.100)GO TO 1241
30710 CC210 IF(IABS(J4).LT.100)GO TO 3241
30800 J4=MOD(J4,100)
30900 RMINI=.7*RMINI
31000 CC3421 J5X=-1
31100 C FOR 2 MARKS AT ONCE.
31200 1241 IF(J5.GE.11)GO TO 28
31300 GO TO (211,211,211,28,28,222,249,60,27,27),J5
31400 RETURN
31500 C ERROR TRAP (I.E. J5=0)
31510 C FOR 1 OR 2 BAR REP SIGNS.
31555 60 CALL BREP(R3,RSTJ2)
31577 RETURN
31600
31700 241 CALL LINES(R3,CENTR,3)
31800 GO TO 210
31805
31900
31910 211 IF(J5.EQ.0)GO TO 2422
31917 C GETS BACK GOOD VERTICAL POS.
31920 IF(J5.GT.3)GO TO 222
31930 C FOR 2-PASS PLOTTING (-2=THIN LINES, -3=HEAVY LINES)
31940 IF(PLT)GO TO 3121
31945 IF(JFONT.NE.0)GO TO 3121
31950 X=NACCI(J5)
31960 CALL RDRAW(X+1,RACCI(X),RACCI,RMINI,R3,CENTR,RMINI)
32000 2422 IF(R6.EQ.0)RETURN
32004 J5=(R6+.001)*100.
32010 R4=RX4
32020 CC R4=RJZ
32100 R3=RJAC
32300 1249 IF(MOD(J5,10).GT.3)GO TO 249
32400 J5=J5/10
32500 IF(J5.GT.30)GO TO 1249
32600 C WHEN P1=1, EXTRACTS ACCENT NUMBERS FROM DECIMALS IN P6.
32700 249 IF(J5.GT.30)GO TO 28
32800 IF(J5.GT.10)GO TO 246
32850 IF(J5.EQ.0)RETURN
32900 IF(JA.NE.1)GO TO 250
33000 CXX 11/74 RH=8
33100 RB=14.
33110 IF(MOD(J4,2).EQ.0)GO TO 244
33200 IF(J5.EQ.7)GO TO 6322
33250 IF(J5.NE.9)GO TO 244
33300 6322 IF(STEM.GT.1)GO TO 7322
33310 IF(J4.LT.5)GO TO 244
33320 7322 IF(J4.LE.9)GO TO 8322
33330 IF(STEM.EQ.2)GO TO 244
33340 IF(STEM.EQ.0)GO TO 244
33500 8322 RB=21
33600 C PUTS ACCENT DOWN OR UP 1 SPACE. AVOIDS PUTTING DOT OR DASH ON LINE
33700 244 IF(STEM.EQ.1)GO TO 9322
33710 IF(STEM.NE.0)GO TO 245
33720 IF(J4.GE.7)GO TO 245
33730 9322 RB=-RB
33800 CC IF(J5.NE.6)GO TO 245
33900 CC IF(J4.LT.9.AND.STEM.EQ.2)GO TO 281
34000 CC IF(J4.GT.4.AND.STEM.EQ.1)GO TO 252
34100 245 CENTR=CENTR+RB*RSTX
34200 250 IF(J5.GT.10)GO TO 281
34210 IF(J5.LT.6)GO TO 281
34300 JA=9
34400 IF(J5.NE.7)GO TO 253
34500 C 7=DOT
34600 RXX=R3
34700 R3=R3+6.7*RMINI
34800 C CENTERS THE DOT
34900 GO TO 29
35000 253 IF(J5.EQ.9)GO TO 271
35100 C 9=DASH
35200 251 IF(RB.LT.0)RINV=-RINV
35300 C FIX THIS!!!! FOR BOWINGS, ETC.
35310 2222 IF(J5.NE.20)GO TO 2223
35315 CZZZZZZZZZZZ
35320 JA=7
35330 R5=0
35340 J7=1
35350 CALL ALPHA
35360 C FOR TRILL -- J5=20
35370 RETURN
35380 2223 IF(J5.EQ.17)GO TO 323
35385 IF(J5.NE.18)GO TO 222
35387 323 RINV=J5
35390 C FOR MORD, INV.MORD
35400 222 CALL FERMTA(RINV)
35500 GO TO 5241
35600 252 RX=POS
35700 248 CENTR=RX
35800 GO TO 251
35900 246 IF(J5.LT.10)GO TO 245
36000 R4=R4+3
36100 IF(STEM.EQ.1)R4=R4+6.+R8
36200 IF(R4.LT.12.5)R4=12.5
36300 CALL CENTX
36400 IF(J5.EQ.26)GO TO 222
36500 C 26 IS NEW NUMB FOR FERMATA.
36700 28 IF(J5.LT.30)GO TO 281
36800 J5X=MOD(J5,10)
36900 C J5X SAVES NEXT MARK.
37000 IF(J5X.LT.4)J5X=0
37100 J5=J5/10
37200 IF(J5.GT.30)RETURN
37300 C WON'T READ 415 ETC. (CORRECT=154)
37400 C DOES BOTTOM MARK FIRST, THEN TOP.
37500 CALL EXCH(J5X,J5)
37600 C PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
37700 IF(JA.EQ.1)GO TO 249
37800 GO TO 1241
37900 281 X=1
37950 IF(J5.GT.16)GO TO 2222
37975 C JUMP FOR MORD, INV.MORD, TRILL
38000 IF(J5.NE.4)GO TO 228
38100 X=5
38200 CALL RJBX(.5)
38300 GO TO 328
38400 228 IF(J5.GT.10)X=XAC(J5-10)
38500 C X IS POINTER IN RACNT ARRAY
38600 328 RA=RMINI
38700 C OR RSTJ2?
38800 IF(RINV.LT.0)GO TO 1323
38810 IF(STEM.NE.1)GO TO 2323
38820 IF(J5.NE.4)GO TO 2323
38830 1323 RA=-RA
38850 C ↓↓↓ X ↓↓↓ PICKS UP TYPO ERRORS
38900 2323 IF(X.LT.54)CALL RDRAW(X+1,RACNT(X),RACNT,RA,R3,CENTR,RMINI)
39000 C PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
39100 C IN ARRAY, 33.012 WOULD BE X=33, Y=12. 101.123 IS X=-1, Y=-23.
39200 GO TO 5241
39300 4241 JJJ=J5
39400 J5=J5X
39500 J5X=-1
39600 IF(JAX.NE.1)GO TO 7241
39700 IF(J5.GT.10)GO TO 246
39800 IF(J5.NE.7)GO TO 7241
39810 IF(JJJ.NE.9)GO TO 249
39900 7241 RXX=8.5*RMINI
39950 C↑↑↑↑↑↑ 11/74 WAS RH*
40000 IF(STEM.EQ.1)RXX=-RXX
40100 CENTR=CENTR+RXX
40200 IF(J5.EQ.26)J5=6
40300 C TEMPORARY?? FIX
40400 GO TO 1241
40500 C >=5, ∧=4
40600 27 R3=J3
40700 C DASHES
40800 271 CALL LINX(R3,CENTR,R3+RMINI*14.,CENTR)
40850 C **** **** *** ↑↑↑↑↑↑↑↑↑↑ THIS WAS RSTJ2 11/74
40900 5241 IF(J5X.GT.0)GO TO 4241
41000 C J5X IS FOR DOUBLE MARKS. (WHAT ABOUT DOT POSITION.)
41100 RETURN
41200 6241 R3=RXX
41300 C RESET R3 AFTER A DOT.
41400 GO TO 5241
42010 3121 J5=J5+9
42015 C SOON WILL HAVE DBL FLAT (4) AND DBL SHRP (5)
42020 C TO DRAW GOOD ACCIS ON PLOTTER - NOT ON DPY.(IN CLEF4.DMD)
42030 CALL DRWNT(RMINI)
42040 GO TO 2422
50200 END